COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TEST4"
C00003 00003	
C00004 00004	SIMPLE PROCEDURE DPYF (INTEGER F)
C00005 00005		SCALE ← 1000
C00006 00006		OUTSTR("	ZCUT = ")
C00008 ENDMK
C⊗;
BEGIN "TEST4"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "GEOMES.HDR" SOURCE_FILE;
	REQUIRE "SLICE" LOAD_MODULE;

	INTEGER B1,B2,F0,F,E0,E,V,CHR;
	REAL ZCUT;

	STRING STR;
	EXTERNAL ITG SUBR SLICE (INTEGER B;REAL Z);
	EXTERNAL ITG ARRAY DPYBUF[0:1];


	REAL XMAX,YMAX,ZMAX;
	REAL XMIN,YMIN,ZMIN;
	REAL SCALE;

ITG SUBR BOUNDS (ITG B);
BEGIN "BOUNDS"
	ITG V;

α VERTEX SCAN FOR MINAMAX LOCI;
	XMAX ← YMAX ← ZMAX ← -1000;
	XMIN ← YMIN ← ZMIN ← +1000;
	V ← PVT(B);
	DO BEGIN
		IF XWC(V) > XMAX THEN XMAX ← XWC(V);
		IF YWC(V) > YMAX THEN YMAX ← YWC(V);
		IF ZWC(V) > ZMAX THEN ZMAX ← ZWC(V);
		IF XWC(V) < XMIN THEN XMIN ← XWC(V);
		IF YWC(V) < YMIN THEN YMIN ← YWC(V);
		IF ZWC(V) < ZMIN THEN ZMIN ← ZWC(V);
	END UNTIL B=(V←PVT(V));

END "BOUNDS";
SIMPLE PROCEDURE DPYF (INTEGER F);
BEGIN "DPYF"
	INTEGER E,E0,V,I;
	E ← E0 ← PED(F); I←0;
	V ← VCW(E0,F);AIVECT(SCALE*XWC(V),SCALE*YWC(V));
	DO BEGIN V ← VCCW(E,F); I←I+1;
	AVECT(SCALE*XWC(V),SCALE*YWC(V));
	END UNTIL E0 = (E←ECCW(E,F));
	DPYSST(CVS(I));
END "DPYF";
	SCALE ← 1000;

	GEONIT;
	B1 ← IGEM("HIP.GEM[GEM,BGB]");
	ICAM("TMP.CAM[GEM,BGB]");

	BOUNDS(B1);
	B2 ← MKCUBE(XMAX-XMIN,YMAX-YMIN,ZMAX-ZMIN);
	TRANSLATE(B2,(XMAX+XMIN)/2,(YMAX+YMIN)/2,(ZMAX+ZMIN)/2);

	F ← SLICE(B1,0.2);
	TRANSLATE(BGET(F),0,0,1/6);
	GEODPY;INCHRW;
	TRANSLATE(BGET(F),0,0,1/6);
	GEODPY;INCHRW;
	TRANSLATE(BGET(F),0,0,1/6);
	GEODPY;INCHRW;
	TRANSLATE(BGET(F),0,0,1/6);
	GEODPY;INCHRW;
	OUTSTR("	ZCUT = ");
	STR ← INCHWL;
	ZCUT ← REALSCAN(STR,CHR)/12;
	F0 ← F ← SLICE(B1,ZCUT);
	
	DPYSET(DPYBUF);

	AIVECT(SCALE*XMIN,SCALE*YMIN);
	AVECT(SCALE*XMAX,SCALE*YMIN);
	AVECT(SCALE*XMAX,SCALE*YMAX);
	AVECT(SCALE*XMIN,SCALE*YMAX);
	AVECT(SCALE*XMIN,SCALE*YMIN);

	IF F THEN
	DO DPYF(F) UNTIL F0 = (F←CDR8(F));
	DPYOUT(1);

	WHILE TRUE DO INCHWL;

END "TEST4"; BGB 11 JANUARY 1974.